home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / Display.Mod (.txt) < prev    next >
Oberon Text  |  1994-07-26  |  9KB  |  181 lines
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 26 Jul 94
  5. MODULE Display; (*mf 9.3.93/ mah 
  6. IMPORT
  7.     SYS:=SYSTEM, Macintosh, Sys;
  8. CONST
  9.     black*=0; white*=15;
  10.     replace*=0; paint*=1; invert*=2;
  11.     Pattern*=LONGINT;
  12.     Font*=POINTER TO Bytes;
  13.     Bytes*=RECORD END; (* really: Macintosh.FontMap *)
  14.     Frame*=POINTER TO FrameDesc;
  15.     FrameMsg*=RECORD END;
  16.     Handler*=PROCEDURE(f: Frame; VAR msg: FrameMsg);
  17.     FrameDesc*=RECORD 
  18.         dsc*, next*: Frame;
  19.         X*, Y*, W*, H*: INTEGER;
  20.         handle*: Handler
  21.     END;
  22.     Unit*: LONGINT;
  23.     Left*, ColLeft*, Bottom*, UBottom*, Width*, Height*: INTEGER;
  24.     arrow*, star*, hook*, cross*, downArrow*, grey0*, grey1*, grey2*, ticks*: Pattern;
  25. (* Display Procedures *)
  26.     PROCEDURE Map*(x: INTEGER): LONGINT;
  27.     BEGIN RETURN SYS.VAL(LONGINT, Macintosh.thePortPtr)
  28.     END Map;
  29.     PROCEDURE SetMode*(x: INTEGER; s: SET);
  30.     END SetMode;
  31. (* Color Display *)
  32.     PROCEDURE SetColor*(col, red, green, blue: INTEGER);
  33.     BEGIN Macintosh.SetColor(col, red, green, blue)
  34.     END SetColor;
  35.     PROCEDURE GetColor*(col: INTEGER; VAR red, green, blue: INTEGER);
  36.     BEGIN Macintosh.GetColor(col, red, green, blue)
  37.     END GetColor;
  38. (* Fonts / Patterns *)
  39.     PROCEDURE GetChar*(f: Font; ch: CHAR; VAR dx, x, y, w, h: INTEGER; VAR p: LONGINT);
  40.     BEGIN Macintosh.GetChar(SYS.VAL(LONGINT, f), ch, dx, x, y, w, h, p)
  41.     END GetChar;
  42.     PROCEDURE NewPattern*(VAR image: ARRAY OF SET; w, h: INTEGER): Pattern;
  43.     VAR i, j : INTEGER; s : SET;
  44.     BEGIN
  45.         i:=SHORT (LEN (image));
  46.         WHILE i>0 DO
  47.             DEC (i); s:={};
  48.             FOR j:=0 TO 31 DO IF j IN image[i] THEN INCL (s, 31-j) END END;
  49.             image[i]:=s
  50.         END;
  51.         RETURN SYS.VAL(Pattern, Macintosh.NewPatMap(image, w, h, 1))
  52.     END NewPattern;
  53. (* Auxiliary *)
  54.     PROCEDURE Copy(sx, sy, w, h, dx, dy: INTEGER);
  55.     VAR port: Sys.GrafPtr;
  56.     BEGIN port:=SYS.VAL (Sys.GrafPtr, Macintosh.thePortPtr);
  57.         IF sy<=Height THEN
  58.             IF dy<=Height THEN Macintosh.CopyBlock(port, port, sx, sy, w, h, dx, dy, w, h)
  59.             ELSE Macintosh.CopyBlock(port, Macintosh.shadowPortPtr, sx, sy, w, h, dx, dy, w, h) END
  60.         ELSIF dy<=Height THEN Macintosh.CopyBlock(Macintosh.shadowPortPtr, port, sx, sy, w, h, dx, dy, w, h)
  61.         ELSE Macintosh.CopyBlock(Macintosh.shadowPortPtr, Macintosh.shadowPortPtr, sx, sy, w, h, dx, dy, w, h) END
  62.     END Copy;
  63. (* RasterOps *)
  64.     PROCEDURE CopyBlock*(sx, sy, w, h, dx, dy, mode: INTEGER);
  65.     BEGIN Macintosh.SetPenScreen(dy>=0, Macintosh.thePortClip, white, mode); Copy(sx, Height-sy, w, h, dx, Height-dy)
  66.     END CopyBlock;
  67.     PROCEDURE CopyPattern*(col: INTEGER; pat: Pattern; x, y, mode: INTEGER);
  68.     BEGIN Macintosh.CopyPatternScreen(y>=0, Macintosh.thePortClip, col, pat, x, Height-y, mode)
  69.     END CopyPattern;
  70.     PROCEDURE ReplPattern*(col: INTEGER; pat: LONGINT; x, y, w, h, mode: INTEGER);
  71.     BEGIN Macintosh.SetPenScreen(y>=0, Macintosh.thePortClip, col, mode); Macintosh.ReplPattern(pat, x, Height-y, w, h)
  72.     END ReplPattern;
  73.     PROCEDURE ReplConst*(col, x, y, w, h, mode: INTEGER);
  74.     BEGIN
  75.         Macintosh.SetPenScreen(y>=0, Macintosh.thePortClip, col, mode);
  76.         Macintosh.ReplConst(x, Height-y, w, h)
  77.     END ReplConst;
  78.     PROCEDURE Dot*(col: INTEGER; x, y, mode: INTEGER);
  79.     BEGIN Macintosh.SetPenScreen(y>=0, Macintosh.thePortClip, col, mode); Macintosh.Dot(x, Height-1-y)
  80.     END Dot;
  81. (* RasterOps with Clipping *)
  82.     PROCEDURE CopyBlockC*(F: Frame; sx, sy, w, h, dx, dy, mode: INTEGER);
  83.     BEGIN Macintosh.SetUserClip(F.X, Height-F.Y, F.W, F.H);
  84.         Macintosh.SetPenScreen(F.Y>=0, Macintosh.userClip, white, mode); Copy(sx, Height-sy, w, h, dx, Height-dy)
  85.     END CopyBlockC;
  86.     PROCEDURE CopyPatternC*(F: Frame; col: INTEGER; pat: Pattern; x, y, mode: INTEGER);
  87.     BEGIN Macintosh.SetUserClip(F.X, Height-F.Y, F.W, F.H);
  88.         Macintosh.CopyPatternScreen(F.Y>=0, Macintosh.userClip, col, pat, x, Height-y, mode)
  89.     END CopyPatternC;
  90.     PROCEDURE ReplPatternC*(F: Frame; col: INTEGER; pat: LONGINT; x, y, w, h, xp, yp, mode: INTEGER);
  91.     BEGIN Macintosh.SetUserClip(F.X, Height-F.Y, F.W, F.H);
  92.         Macintosh.SetPenScreen(F.Y>=0, Macintosh.userClip, col, mode); Macintosh.ReplPattern(pat, x, Height-y, w, h)
  93.     END ReplPatternC;
  94.     PROCEDURE ReplConstC*(F: Frame; col, x, y, w, h, mode: INTEGER);
  95.     BEGIN Macintosh.SetUserClip(F.X, Height-F.Y, F.W, F.H);
  96.         Macintosh.SetPenScreen(F.Y>=0, Macintosh.userClip, col, mode); Macintosh.ReplConst(x, Height-y, w, h)
  97.     END ReplConstC;
  98.     PROCEDURE DotC*(F: Frame; col: INTEGER; x, y, mode: INTEGER);
  99.     BEGIN Macintosh.SetUserClip(F.X, Height-F.Y, F.W, F.H);
  100.         Macintosh.SetPenScreen(F.Y>=0, Macintosh.userClip, col, mode); Macintosh.Dot(x, Height-1-y)
  101.     END DotC;
  102. (* Initialization *)
  103.     PROCEDURE InitPat;
  104.         VAR img: ARRAY 17 OF SET;
  105.     BEGIN
  106.             img[1]:={13}; img[2]:={12..14}; img[3]:={11..13}; img[4]:={10..12};
  107.             img[5]:={9..11}; img[6]:={8..10}; img[7]:={7..9}; img[8]:={0, 6..8};
  108.             img[9]:={0, 1, 5..7}; img[10]:={0..2, 4..6}; img[11]:={0..5}; img[12]:={0..4};
  109.             img[13]:={0..5}; img[14]:={0..6}; img[15]:={0..7};
  110.         arrow:=NewPattern(img, 15, 15);
  111.             img[1]:={0..7}; img[2]:={0..6}; img[3]:={0..5}; img[4]:={0..4};
  112.             img[5]:={0..3}; img[6]:={0..2}; img[7]:={0..1}; img[8]:={0};
  113.         hook:=NewPattern(img, 8, 8);
  114.             img[1]:={0, 10}; img[2]:={1, 9}; img[3]:={2, 8}; img[4]:={3, 7};
  115.             img[5]:={4, 6}; img[6]:={}; img[7]:={4, 6}; img[8]:={3, 7};
  116.             img[9]:={2, 8}; img[10]:={1, 9}; img[11]:={0, 10};
  117.         cross:=NewPattern(img, 11, 11);
  118.             img[1]:={6}; img[2]:={5..7}; img[3]:={4..8}; img[4]:={3..9};
  119.             img[5]:={2..10}; img[6]:={5..7}; img[7]:={5..7}; img[8]:={5..7};
  120.             img[9]:={5..7}; img[10]:={5..7}; img[11]:={5..7}; img[12]:={5..7};
  121.             img[13]:={5..7}; img[14]:={5..7}; img[15]:={};
  122.         downArrow:=NewPattern(img, 15, 15);
  123.             img[1]:={0, 4, 8, 12}; img[2]:={}; img[3]:={2, 6, 10, 14}; img[4]:={};
  124.         grey0:=NewPattern(img, 16, 4);
  125.             img[1]:={0, 2, 4, 6, 8, 10, 12, 14}; img[2]:={1, 3, 5, 7, 9, 11, 13, 15};
  126.         grey1:=NewPattern(img, 16, 2);
  127.             img[1]:={0, 1, 4, 5, 8, 9, 12, 13}; img[2]:={0, 1, 4, 5, 8, 9, 12, 13};
  128.             img[3]:={2, 3, 6, 7, 10, 11, 14, 15}; img[4]:={2, 3, 6, 7, 10, 11, 14, 15};
  129.         grey2:=NewPattern(img, 16, 4);
  130.             img[1]:={7}; img[2]:={7}; img[3]:={2, 7, 12}; img[4]:={3, 7, 11};
  131.             img[5]:={4, 7, 10}; img[6]:={5, 7, 9}; img[7]:={6..8}; img[8]:={0..6, 8..14};
  132.             img[9]:={6..8}; img[10]:={5, 7, 9}; img[11]:={4, 7, 10}; img[12]:={3, 7, 11};
  133.             img[13]:={2, 7, 12}; img[14]:={7}; img[15]:={7};
  134.         star:=NewPattern(img, 15, 15);
  135.             img[1]:={0}; img[2]:={}; img[3]:={}; img[4]:={};
  136.             img[5]:={}; img[6]:={}; img[7]:={}; img[8]:={};
  137.             img[9]:={}; img[10]:={}; img[11]:={}; img[12]:={};
  138.             img[13]:={}; img[14]:={}; img[15]:={}; img[16]:={};
  139.         ticks:=NewPattern(img, 32, 16)
  140.     END InitPat;
  141. (*    PROCEDURE InitPat;
  142.         VAR img: ARRAY 17 OF SET;
  143.     BEGIN
  144.             img[1]:={18}; img[2]:={17..19}; img[3]:={18..20}; img[4]:={19..21};
  145.             img[5]:={20..22}; img[6]:={21..23}; img[7]:={22..24}; img[8]:={23..25, 31};
  146.             img[9]:={24..26, 30, 31}; img[10]:={25..27, 29..31}; img[11]:={26..31}; img[12]:={27..31};
  147.             img[13]:={26..31}; img[14]:={25..31}; img[15]:={24..31};
  148.         arrow:=NewPattern(img, 15, 15);
  149.             img[1]:={24..31}; img[2]:={25..31}; img[3]:={26..31}; img[4]:={27..31};
  150.             img[5]:={28..31}; img[6]:={29..31}; img[7]:={30..31}; img[8]:={31};
  151.         hook:=NewPattern(img, 8, 8);
  152.             img[1]:={21, 31}; img[2]:={22, 30}; img[3]:={23, 29}; img[4]:={24, 28};
  153.             img[5]:={25, 27}; img[6]:={}; img[7]:={25, 27}; img[8]:={24, 28};
  154.             img[9]:={23, 29}; img[10]:={22, 30}; img[11]:={21, 31};
  155.         cross:=NewPattern(img, 11, 11);
  156.             img[1]:={25}; img[2]:={24..26}; img[3]:={23..27}; img[4]:={22..28};
  157.             img[5]:={21..29}; img[6]:={24..26}; img[7]:={24..26}; img[8]:={24..26};
  158.             img[9]:={24..26}; img[10]:={24..26}; img[11]:={24..26}; img[12]:={24..26};
  159.             img[13]:={24..26}; img[14]:={24..26}; img[15]:={};
  160.         downArrow:=NewPattern(img, 15, 15);
  161.             img[1]:={19, 23, 27, 31}; img[2]:={}; img[3]:={17, 21, 25, 29}; img[4]:={};
  162.         grey0:=NewPattern(img, 16, 4);
  163.             img[1]:={17, 19, 21, 23, 25, 27, 29, 31}; img[2]:={16, 18, 20, 22, 24, 26, 28, 30};
  164.         grey1:=NewPattern(img, 16, 2);
  165.             img[1]:={18, 19, 22, 23, 26, 27, 30, 31}; img[2]:={18, 19, 22, 23, 26, 27, 30, 31};
  166.             img[3]:={16, 17, 20, 21, 24, 25, 28, 29}; img[4]:={16, 17, 20, 21, 24, 25, 28, 29};
  167.         grey2:=NewPattern(img, 16, 4);
  168.             img[1]:={24}; img[2]:={24}; img[3]:={19, 24, 29}; img[4]:={20, 24, 28};
  169.             img[5]:={21, 24, 27}; img[6]:={22, 24, 26}; img[7]:={23..25}; img[8]:={17..23, 25..31};
  170.             img[9]:={23..25}; img[10]:={22, 24, 26}; img[11]:={21, 24, 27}; img[12]:={20, 24, 28};
  171.             img[13]:={19, 24, 29}; img[14]:={24}; img[15]:={24};
  172.         star:=NewPattern(img, 15, 15);
  173.             img[1]:={31}; img[2]:={}; img[3]:={}; img[4]:={};
  174.             img[5]:={}; img[6]:={}; img[7]:={}; img[8]:={};
  175.             img[9]:={}; img[10]:={}; img[11]:={}; img[12]:={};
  176.             img[13]:={}; img[14]:={}; img[15]:={}; img[16]:={};
  177.         ticks:=NewPattern(img, 32, 16)
  178.     END InitPat;*)
  179. BEGIN Unit:=10000; Width:=Macintosh.thePortW; Height:=Macintosh.thePortH; UBottom:=-Macintosh.shadowH; InitPat
  180. END Display.
  181.